home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #21 (1994-01-12)(Diesel)(DE)[WB].zip / Purity #21 (1994-01-12)(Diesel)(DE)[WB].adf / ModToPas / txt / Damen.pas < prev    next >
Pascal/Delphi Source File  |  1993-12-13  |  2KB  |  94 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    Dame.mod
  4.     :Contents.   Lösung des 8-Damen Problems
  5.     :Author.     Markus Uhlendahl
  6.     :Address.    Vorm Burgtor 16, 4408 Dülmen
  7.     :Phone.      02594/81540
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga AMSoft V3.3d
  11.  
  12. **********************************************************************)
  13. PROGRAM Damen;
  14.  
  15.  
  16.  
  17.  
  18. CONST n = 8;
  19.  
  20.  
  21. TYPE vektorTyp = ARRAY[0..n] OF INTEGER;
  22.  
  23.  
  24. VAR v : vektorTyp;
  25.     i : INTEGER;
  26.     l : INTEGER;
  27.  
  28.  
  29. PROCEDURE Ausgabe (v : vektorTyp);
  30.  
  31.   VAR i : INTEGER;
  32.  
  33.   BEGIN
  34.     FOR i:=1 TO n DO BEGIN
  35.       Write ('(');Write (v[i]:2);Write ('|');
  36.       Write (i:2);Write (')');
  37.     END;
  38.     WriteLn;
  39.   END;
  40.  
  41.  
  42. FUNCTION akzeptiert (v : vektorTyp) : BOOLEAN;
  43.  
  44.   VAR a : BOOLEAN;
  45.       i : INTEGER;
  46.  
  47.   BEGIN
  48.     a:=TRUE;
  49.     i:=1;
  50.     WHILE (i<v[0]) AND (a) DO BEGIN
  51.       IF v[v[0]]=v[i] THEN BEGIN
  52.         a:=FALSE;
  53.       END;
  54.       IF v[v[0]]+v[0]=v[i]+i THEN BEGIN
  55.         a:=FALSE;
  56.       END;
  57.       IF v[v[0]]-v[0]=v[i]-i THEN BEGIN
  58.         a:=FALSE;
  59.       END;
  60.       i:=i+1;
  61.     END;
  62.     akzeptiert:= (a); EXIT;
  63.   END;
  64.  
  65.  
  66. PROCEDURE versuche (v : vektorTyp);
  67.  
  68.   VAR i : INTEGER;
  69.  
  70.   BEGIN
  71.     v[0]:=v[0]+1;
  72.     FOR i:=1 TO n DO BEGIN
  73.       v[v[0]]:=i;
  74.       IF akzeptiert (v) THEN BEGIN
  75.         IF v[0]=n THEN BEGIN
  76.           Ausgabe (v);
  77.           l:=l+1;
  78.         END ELSE BEGIN
  79.           versuche (v);
  80.         END;
  81.       END;
  82.     END;
  83.   END;
  84.  
  85.  
  86. BEGIN
  87.   l:=0;
  88.   FOR i:=0 TO n DO BEGIN
  89.     v[i]:=0;
  90.   END;
  91.   versuche (v);
  92.   Write ('Anzahl der Lösungen:');Write (l:6);WriteLn;
  93. END.
  94.